home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tbproc.arc / TPRO3.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-08-16  |  3.6 KB  |  119 lines
  1. {
  2.  
  3.                    T P R O    N U M B E R    3
  4.  
  5.    The following is a set of procedures that we have been used in
  6. various commercial programs. Feel free to use them for commercial
  7. and noncomercial uses. We claim no responsibility to the outcome of
  8. the use of these procedures. You are using them at your own risk.
  9. Enough of the legalities. If you find these routines useful, we
  10. would greatly appreciate any small donation.
  11.  
  12.  
  13.  
  14.  
  15.                                 Soft-Touch Computers
  16.                                 James Billmeyer
  17.                                 7716 Balboa Blvd, Unit D
  18.                                 Van Nuys, Ca  91406
  19.  }
  20.  
  21.  
  22. program ddatest(input,output);
  23.  
  24. type
  25.    line_info = record
  26.                   x1,
  27.                   y1,
  28.                   x2,
  29.                   y2 :  integer;
  30.                end;
  31.  
  32. var
  33.    xdir,ydir     :  integer;
  34.    i,j           :  integer;
  35.    x1,x2,x21,x22,
  36.    y1,y2,y21,y22 :  integer;
  37.    line1,line2   :  line_info;
  38.  
  39.  
  40.  
  41. procedure drawline(var line: line_info);
  42.  
  43. (**************************************************)
  44. (*  The drawline procedure  draws line  at about  *)
  45. (*  13,000 pixel per second  in  hires  graphics  *)
  46. (*  mode. There is not any  boundery  or  window  *)
  47. (*  checking in this procedure.                   *)
  48. (*  The input must be  of the  line_info  record  *)
  49. (*  format, where x1,y1,x2,y2 locate  the  line.  *)
  50. (*  Each pixel of the line  i s xored  onto  the  *)
  51. (*  screen. Draw a line once to place  it on the  *)
  52. (*  screen, draw it once again to remove it.      *)
  53. (*  variables  "XDir" and "YDir" must be defined  *)
  54. (*  before entering the drawline procedure.       *)
  55. (*  This procedure work on all versions of Turbo  *)
  56. (*  Pascal.                                       *)
  57. (**************************************************)
  58.  
  59.  
  60. begin
  61.  
  62.    inline ($55/$8B/$EC/$8B/$76/$08/$8B/$0C/$8B/$54/$02/$BF/$01/$00/$B8/$00/$B8/
  63.            $8E/$C0/$8B/$44/$04/$2B/$C1/$7D/$04/$F7/$DF/$F7/$D8/$89/$3E/Xdir/$BF/
  64.            $01/$00/$8B/$5C/$06/$2B/$DA/$7D/$04/$F7/$DF/$F7/$DB/$89/$3E/Ydir/$3B/
  65.            $D8/$7E/$0C/$8B/$F3/$46/$8B/$FB/$F7/$DF/$D1/$FF/$EB/$0C/$90/$8B/$F0/
  66.            $46/$8B/$F8/$F7/$DF/$D1/$FF/$03/$F8/$53/$51/$50/$8B/$C2/$8A/$E0/$25/
  67.            $FE/$01/$D1/$E0/$D1/$E0/$D1/$E0/$8B/$D8/$80/$E7/$07/$D1/$E0/$D1/$E0/
  68.            $03/$D8/$8B/$C1/$80/$E1/$07/$D1/$F8/$D1/$F8/$D1/$F8/$03/$D8/$B0/$80/
  69.            $D2/$E8/$26/$30/$07/$58/$59/$5B/$4E/$74/$18/$83/$FF/$00/$7C/$0B/$03/
  70.            $0E/Xdir/$2B/$FB/$83/$FF/$00/$7D/$bb/$03/$16/Ydir/$03/$F8/$EB/$b3/$5D)
  71. end;
  72.  
  73.  
  74. begin  (* main program *)
  75.    graphmode;
  76.    hires;
  77.    palette(3);
  78.    hirescolor(white);
  79.    gotoxy(24,1); write('Turbo Pascal Draw procedure Demo');
  80.    for i := 1 to 100  do
  81.       begin
  82.          x21 := x1;
  83.          y21 := y1;
  84.          x22 := x2;
  85.          y22 := y2;
  86.          x1 := 1+i;
  87.          y1 := 200-i;
  88.          x2 := 640-i;
  89.          y2 := 1+i;
  90.          draw(x21,y21,x22,y22,0);
  91.          draw(x1,y1,x2,y2,1);
  92.       end;
  93.    draw(x1,y1,x2,y2,0);
  94.    gotoxy(22,1); write('Soft-Touchs DrawLine procedure Demo');
  95.    with  line1  do
  96.       begin
  97.          x1 := 0;
  98.          y1 := 0;
  99.          x2 := 0;
  100.          y2 := 0;
  101.       end;
  102.    for j := 1 to 3  do
  103.       for i := 1 to 200  do
  104.          begin
  105.             line2 := line1;
  106.             with  line1  do
  107.                begin
  108.                   x1 := 1+i;
  109.                   y1 := 200-i;
  110.                   x2 := 640-i;
  111.                   y2 := 1+i;
  112.                end;
  113.             drawline(line2);
  114.             drawline(line1);
  115.          end;
  116.    textmode(bw80);
  117.    textcolor(lightgray);
  118. end.  (* main program *)
  119.